home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mouscrol / mouscrol.frm < prev    next >
Text File  |  1995-05-07  |  7KB  |  230 lines
  1. VERSION 2.00
  2. Begin Form frmMousScrol 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Mouse Scrolling"
  6.    ClientHeight    =   4740
  7.    ClientLeft      =   2445
  8.    ClientTop       =   1545
  9.    ClientWidth     =   4140
  10.    Height          =   5145
  11.    Icon            =   MOUSCROL.FRX:0000
  12.    Left            =   2385
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   4740
  15.    ScaleWidth      =   4140
  16.    Top             =   1200
  17.    Width           =   4260
  18.    Begin CommandButton cmdExit 
  19.       Caption         =   "E&xit"
  20.       FontBold        =   0   'False
  21.       FontItalic      =   0   'False
  22.       FontName        =   "MS Sans Serif"
  23.       FontSize        =   8.25
  24.       FontStrikethru  =   0   'False
  25.       FontUnderline   =   0   'False
  26.       Height          =   400
  27.       Left            =   1620
  28.       TabIndex        =   1
  29.       Top             =   4140
  30.       Width           =   1000
  31.    End
  32.    Begin PictureBox pic 
  33.       BorderStyle     =   0  'None
  34.       Height          =   3060
  35.       Left            =   500
  36.       ScaleHeight     =   3060
  37.       ScaleWidth      =   3135
  38.       TabIndex        =   0
  39.       Top             =   500
  40.       Width           =   3135
  41.       Begin Image img 
  42.          Height          =   4305
  43.          Left            =   0
  44.          Picture         =   MOUSCROL.FRX:0302
  45.          Top             =   0
  46.          Width           =   6600
  47.       End
  48.    End
  49. End
  50. Option Explicit
  51.  
  52. Dim MouseDownX, MouseDownY As Integer
  53. Dim NewLeft, NewTop As Integer
  54. Dim VScrollMax, HScrollMax  As Integer
  55. Dim VScrollMin, HScrollMin  As Integer
  56.  
  57. ' Shift parameter masks
  58. Const SHIFT_MASK = 1
  59. Const CTRL_MASK = 2
  60. Const ALT_MASK = 4
  61.  
  62. ' Button parameter masks
  63. Const LEFT_BUTTON = 1
  64. Const RIGHT_BUTTON = 2
  65. Const MIDDLE_BUTTON = 4
  66.  
  67. 'Colors
  68. Const G_BLACK = 0
  69. Const G_BLUE = 1
  70. Const G_GREEN = 2
  71. Const G_CYAN = 3
  72. Const G_RED = 4
  73. Const G_MAGENTA = 5
  74. Const G_BROWN = 6
  75. Const G_LIGHT_GRAY = 7
  76. Const G_DARK_GRAY = 8
  77. Const G_LIGHT_BLUE = 9
  78. Const G_LIGHT_GREEN = 10
  79. Const G_LIGHT_CYAN = 11
  80. Const G_LIGHT_RED = 12
  81. Const G_LIGHT_MAGENTA = 13
  82. Const G_YELLOW = 14
  83. Const G_WHITE = 15
  84. Const G_AUTOBW = 16
  85.  
  86. Sub cmdExit_Click ()
  87.  
  88.     End
  89.  
  90. End Sub
  91.  
  92. Sub DrawFrameOn (TopLeftControl As Control, BottomRightControl As Control, Style As String, FrameOffset As Integer, Color As Integer, TopLeftEdges As Integer, BottomRightEdges As Integer)
  93.  
  94.     Dim SaveDrawWidth, SaveFillStyle, SaveScaleMode
  95.     Dim Offset, TWIPS As Integer
  96.     Dim xx, yy As Integer
  97.     Dim x1, y1, x2, y2 As Integer
  98.     Dim FrameLeft, FrameTop, FrameWidth, FrameHeight
  99.     
  100.     SaveDrawWidth = DrawWidth
  101.     SaveFillStyle = FillStyle
  102.     SaveScaleMode = ScaleMode
  103.     
  104.     DrawWidth = 1
  105.     FillStyle = 1
  106.     ScaleMode = 1
  107.  
  108.     TWIPS = screen.TwipsPerPixelX
  109.     Offset = FrameOffset * TWIPS
  110.  
  111.     FrameLeft = TopLeftControl.Left
  112.     FrameTop = TopLeftControl.Top
  113.     FrameWidth = BottomRightControl.Left + BottomRightControl.Width
  114.     FrameHeight = BottomRightControl.Top + BottomRightControl.Height
  115.     
  116.     ' Draw a colored box the same size as the largest Frame.
  117.     x1 = FrameLeft - Offset
  118.     y1 = FrameTop - Offset
  119.     x2 = FrameWidth + Offset - TWIPS
  120.     y2 = FrameHeight + Offset - TWIPS
  121.     Line (x1, y1)-(x2, y2), QBColor(Color), BF
  122.  
  123.     ' Raised or inset shading
  124.     If UCase$(Left$(Style, 1)) = "R" Then
  125.         xx = TopLeftEdges
  126.         yy = BottomRightEdges
  127.     Else
  128.         xx = BottomRightEdges
  129.         yy = TopLeftEdges
  130.     End If
  131.     
  132.     ' Bottom-left to Top-left line
  133.     x1 = FrameLeft - Offset
  134.     y1 = FrameHeight + Offset - TWIPS
  135.     x2 = FrameLeft - Offset
  136.     y2 = FrameTop - Offset - TWIPS
  137.     Line (x1, y1)-(x2, y2), QBColor(xx)
  138.     
  139.     ' Top-left to Top-Right line
  140.     x1 = FrameLeft - Offset
  141.     y1 = FrameTop - Offset
  142.     x2 = FrameWidth + Offset
  143.     y2 = FrameTop - Offset
  144.     Line (x1, y1)-(x2, y2), QBColor(xx)
  145.     
  146.     ' Top-Right to Bottom-Right line
  147.     x1 = FrameWidth + Offset - TWIPS
  148.     y1 = FrameTop - Offset
  149.     x2 = FrameWidth + Offset - TWIPS
  150.     y2 = FrameHeight + Offset
  151.     Line (x1, y1)-(x2, y2), QBColor(yy)
  152.     
  153.     ' Bottom-Right to Bottom-Left line
  154.     x1 = FrameWidth + Offset - TWIPS
  155.     y1 = FrameHeight + Offset - TWIPS
  156.     x2 = FrameLeft - Offset - TWIPS
  157.     y2 = FrameHeight + Offset - TWIPS
  158.     Line (x1, y1)-(x2, y2), QBColor(yy)
  159.     
  160.     DrawWidth = SaveDrawWidth
  161.     FillStyle = SaveFillStyle
  162.     ScaleMode = SaveScaleMode
  163.     
  164. End Sub
  165.  
  166. Sub Form_Load ()
  167.  
  168.     Show
  169.     HScrollMax = -(img.Width - pic.Width)
  170.     VScrollMax = -(img.Height - pic.Height)
  171.     HScrollMin = 0
  172.     VScrollMin = 0
  173.     
  174.     ' Center the image inside the picture box on program start
  175.     img.Left = HScrollMax / 2
  176.     img.Top = VScrollMax / 2
  177.  
  178.     ' Color Constants to be used in DrawFrameOn
  179.     'G_BLACK              G_WHITE
  180.     'G_BLUE               G_LIGHT_BLUE
  181.     'G_GREEN              G_LIGHT_GREEN
  182.     'G_CYAN               G_LIGHT_CYAN
  183.     'G_RED                G_LIGHT_RED
  184.     'G_MAGENTA            G_LIGHT_MAGENTA
  185.     'G_BROWN              G_YELLOW
  186.     'G_LIGHT_GRAY         G_DARK_GRAY
  187.     
  188.     ' DrawFrameOn TopLeftControl, BottomRightControl, Style, FrameOffset
  189.     ' Box Color, Top and Left Lines Color, Bottom and Right Lines Color
  190.     DrawFrameOn pic, pic, "Raised", 24, G_RED, G_BLACK, G_BLACK
  191.     DrawFrameOn pic, pic, "Raised", 23, G_RED, G_WHITE, G_DARK_GRAY
  192.     DrawFrameOn pic, pic, "Raised", 22, G_RED, G_WHITE, G_DARK_GRAY
  193.     DrawFrameOn pic, pic, "Raised", 21, G_RED, G_BLACK, G_BLACK
  194.     DrawFrameOn pic, pic, "Raised", 11, G_LIGHT_GRAY, G_DARK_GRAY, G_WHITE
  195.     DrawFrameOn pic, pic, "Raised", 10, G_YELLOW, G_BLACK, G_BLACK
  196.     DrawFrameOn pic, pic, "Raised", 7, G_LIGHT_GRAY, G_BLACK, G_BLACK
  197.     DrawFrameOn pic, pic, "Raised", 6, G_GREEN, G_WHITE, G_DARK_GRAY
  198.     DrawFrameOn pic, pic, "Raised", 1, G_LIGHT_GRAY, G_BLACK, G_WHITE
  199.  
  200. End Sub
  201.  
  202. Sub img_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  203.  
  204.     Select Case Button
  205.         Case RIGHT_BUTTON
  206.             MouseDownX = X
  207.             MouseDownY = Y
  208.     End Select
  209.         
  210. End Sub
  211.  
  212. Sub img_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  213.  
  214.     If Button = RIGHT_BUTTON Then
  215.  
  216.         NewLeft = img.Left - (MouseDownX - X)
  217.         If NewLeft > HScrollMax And NewLeft < 0 Then
  218.             img.Left = NewLeft
  219.         End If
  220.         
  221.         NewTop = img.Top - (MouseDownY - Y)
  222.         If NewTop > VScrollMax And NewTop < 0 Then
  223.             img.Top = NewTop
  224.         End If
  225.         
  226.     End If
  227.  
  228. End Sub
  229.  
  230.